perm filename CONNEW.F4[OLD,LCS] blob sn#075950 filedate 1974-01-08 generic text, type T, neo UTF8
00100	C  *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314  ***********
00200	C  DEC 17,1970  ********* CONVERTS 18 (AND 12) BIT .DMD FILES  ***********
00300	C   CONVERTS .DMD FILES WRITTEN WITH RCDFLG←1; OR BIGBIT←1;(or ←2;)
00400	C   LOAD WITH FSTUDP.REL AND NORM.REL. (PUTFIL,FASTOU,FINFIL IN FORT.LIB)
00500	C   TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
00600	C   1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
00700	C   2ND IS ACTUAL NAME OF FILE.
00800	C   IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
00900	C   TO BACK UP  TYPE '-1'. 'REWIND' MAY BE TYPED AFTER 'MTA0' OR 'NAME #1'.
01000	C   USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
01100		DIMENSION JSB(128),IBOTT(8000)
01200	150	FORMAT(' WRITE ON UDP?'/)
01300	100	FORMAT(' TYPE NAME #1'/)
01400	200	FORMAT(' TYPE FINAL NAME'/)
01500	250	FORMAT(A1)
01600	300	FORMAT(2XA5,I6,I9)
01700	350	FORMAT(' ASSIGN THE UDP!!'/)
01800	400	FORMAT(A5,2I)
01900	450	FORMAT(' READ FROM MTA0?'/)
02000	500	FORMAT(I,' WORDS,   FACTOR=',F6.3,',  MAXAMP=',I4/)
02100	600	FORMAT(' MORE??'/)
02200	700	FORMAT(' TYPE MAXAMP'/)
02300	800	FORMAT(4I)
02400		EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
02500	  	MUSIC='MUSIC'
02600		TYPE 150
02700		ACCEPT 250,UDP
02800		IF(UDP.EQ.'X')GO TO 440
02900	C  TYPE 'X' TO PASS DSK INITS.
03000		IF(UDP.NE.'Y')CALL PUTMUS(MUSIC)
03100		FACTOR=1.
03200		ISIZE=9000
03300		N=ISIZE
03400		JUDP=4
03500	C   GARPLY READS 4*1024 WDS.
03600		JSIZE=1024
03700		IF(UDP.NE.'Y')GO TO 101
03800		TYPE 350
03900		CALL INTUDP
04000	C********* CHANGE NEXT NUMBER IF PROBLEMS WITH 3330 DISK **************
04100		JSIZE=128*18+32
04200		JUDP=7
04300	C   UDPNEW READS 7*1312 WDS. ***** FOR 2314 DSK **************
04400	101	KSIZE=JSIZE
04500		MX=0
04600		KCNT=0
04700		IX=0
04800		JA=1
04900	440	TYPE 450
05000		ACCEPT 250,TAPE
05100		IF(TAPE.NE.'R')GO TO 54
05200		REWIND 16
05300		TAPE='Y'
05400	54	TYPE 100
05500		JNM='AAAAA'
05600		ACCEPT 400,NAME,MAXAMP
05700	  	IF(MAXAMP.EQ.0)MAXAMP=MX
05800		IF(NAME.EQ.'-1')GO TO 440
05900		IF(NAME.EQ.'NO')GO TO 1201
06000	C   CAN TYPE 'NO' IF MISTAKE EARLIER.
06100		IF(NAME.EQ.' ')NAME='MUSAA'
06200	2	JNM=JNM+((NAME-JNM)/256*256)
06300		KNM=JNM
06400	C   AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
06500	1002	TYPE 200
06600		ACCEPT 400,NM2,KSKIP
06700		IF(NM2.EQ.'-1')GO TO 54
06800		IF(NM2.EQ.' ')NM2=NAME
06900		IF(TAPE.NE.'Y')GO TO 7077
07000		IF(MAXAMP.NE.0)GO TO 2710
07100		TYPE 700
07200		ACCEPT 800,MAXAMP
07300		IF(MAXAMP)GO TO 54
07400		IX=0
07500	2710	IF(NM2.EQ.' ')NM2=NAME
07600	1710	CALL GETTAP
07700	1810	CALL INTAPE(JSB(1),128)
07800		IF(JSB(1))GO TO 1202
07900		TYPE 300,JSB3
08000		IF(IX.OR.JSB2.EQ.3)GO TO 2022
08100		IF(MAXAMP.EQ.0)MAXAMP=2040
08200		GO TO 199
08300	7077	IF(MAXAMP.NE.0)GO TO 4022
08400		CALL GETFIL(NM2)
08500		CALL FASTIN(JSB(1),128)
08600		IF(JSB2.EQ.3)GO TO 4022
08700		JSC=JSB(1)
08800	6066	CALL FASTIN(IBOTT(1),JSC)
08900		IF(IBOTT(JSC).EQ.0)GO TO 6066
09000	     	MAXAMP=IABS(IBOTT(JSC))
09100	4022	IF(N)GO TO 710
09200		N=-2
09300		IF(JSB2.EQ.3)GO TO 710 
09400	199	FACTOR=2040./MAXAMP
09500	    	MX=MAXAMP
09600		IX=-1
09700		KSIZE=3*JSIZE/2
09800		IF(TAPE.EQ.'Y')GO TO 2022
09900	C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
10000	710	IF(TAPE.EQ.'Y')GO TO 1810
10100	   	CALL GETFIL(NAME)
10200	810	CALL FASTIN(JSB(1),128)
10300		IF(JSB2.EQ.3)IX=0
10400	2022	JSC=JSB(1)
10500	1022	IF(JA.GT.KSIZE)GO TO 17
10600	610	IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
10700	    	IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
10800	C   LAST WORD IS THROWN AWAY.
10900		JA=JA+JSC-1
11000		JC=IBOTT(JA)
11100		IF(JC)5,1022,6
11200	5	JA=JA-IBOTT(JA-1)
11300	6	TYPE 300,NAME,JC,KCNT
11400		NAME=NAME+2
11500		IF(NAME.LE.JNM+50)GO TO 27
11600		JNM=JNM+256
11700		IF(JNM.LE.KNM+6400)GO TO 1017
11800		KNM=JNM+26112
11900		JNM=KNM
12000	C   RAISES 'AAAZA' TO 'AABAA'
12100	1017	NAME=JNM
12200	27	IF(NAME.LE.NM2)GO TO 710
12300	1202	TYPE 600
12400		ACCEPT 400,NAME
12500		IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
12600	1201	NM2=NAME-1
12700	17	JC=JA-1
12800		IF(JC.LT.KSIZE)GO TO 23
12900	10	IF(IX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
13000		LSIZE=KSIZE
13100		JMP=-1
13200	32	KCNT=KCNT+JSIZE
13300		IF(UDP.EQ.'Y')GO TO 132
13400		CALL FSTMUS(IBOTT(1),JSIZE)
13500		IF(JMP)7,8,9
13600	132	CALL TOUDP(IBOTT(1),JSIZE)
13700		IF(JMP)7,8,9
13800	7	JC=JC-LSIZE
13900		DO 12 K=1,JC
14000	12	IBOTT(K)=IBOTT(K+LSIZE)
14100		JA=JC+1
14200		IF(JC.GT.KSIZE)GO TO 10
14300		IF(NAME.LE.NM2)GO TO 610
14400	23	IF(IX.EQ.0)GO TO 43
14500		CALL NORM(IBOTT(1),JC,FACTOR)
14600		JC=JC*2/3
14700	43	DO 13 K=JC+1,JSIZE
14800	13	IBOTT(K)=0
14900		JMP=0
15000		GO TO 32
15100	8 	DO 14 K=1,JSIZE
15200	14	IBOTT(K)=0
15300		JMP=1
15400		GO TO 32
15500	9	K=KCNT/JSIZE
15600		L=K-(K/JUDP)*JUDP
15700		IF(L.EQ.0)GO TO 3222
15800		DO 4222 K=1,JSIZE
15900	4222	IBOTT(K)=0
16000		DO 5222 K=1,L
16100		IF(UDP.NE.'Y')GO TO 6222
16200		CALL TOUDP(IBOTT(1),JSIZE)
16300		GO TO 5222
16400	6222	CALL FSTMUS(IBOTT(1),JSIZE)
16500	5222	CONTINUE
16600		KCNT=KCNT+L*JSIZE
16700	3222	IF(UDP.NE.'Y')CALL FINMUS
16800		IF(UDP.EQ.'Y')CALL FINUDP(KCNT)
16900	7222	TYPE 500,KCNT,FACTOR,MAXAMP
17000		END